home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / prog_pas / xport11.zip / FILELOCK.PAS < prev    next >
Pascal/Delphi Source File  |  1996-03-09  |  1KB  |  79 lines
  1. {$O+,F+}
  2. unit filelock;
  3.  
  4. interface
  5.  
  6.  
  7.  procedure delete_file(fn: string);
  8.  procedure unlock_file(file_name:string);
  9.  procedure get_access_hard(file_name:string;check:boolean);
  10.  
  11. implementation
  12.  
  13. uses dos,crt;
  14.  
  15.  
  16. function fileexists(FNAME:string):boolean;
  17.   var tfile:text;
  18.       s: string;
  19.   begin
  20.     s := FSEARCH(FNAME,'');
  21.     fileexists := s <> '';
  22.   end;
  23.  
  24.  
  25. procedure delete_file(fn: string);
  26. var
  27.  f: file;
  28. begin;
  29. {$I-}
  30. if fileexists(fn) then begin;
  31.  assign(f,fn);
  32.  erase(f);
  33. {$I+}
  34. end;
  35. end;
  36.  
  37.  
  38. procedure unlock_file(file_name:string);
  39. var
  40. ar: text;
  41. i: integer;
  42. begin;
  43. file_name[length(file_name)] := 'X';
  44. delete_file(file_name);
  45. end;
  46.  
  47. procedure get_access_hard(file_name:string;check:boolean);
  48. var
  49. ar: text;
  50. i: integer;
  51. begin;
  52. IF NOT FILEEXISTS(file_name) and check then begin
  53.   writeln(file_name,' does not exist!');
  54.   assign(ar,'error.log');
  55.   rewrite(ar);
  56.   writeln(file_name,' Did Not Exist!');
  57.   close(ar);
  58.   halt(0);
  59. end;
  60. {$I-}
  61.  
  62. file_name[length(file_name)] := 'X';
  63. if fileexists(file_name) then begin;
  64.   i := 1;
  65.   repeat;
  66.   delay(100);
  67.   inc(i);
  68.   if i = 10 then delete_file(file_name);
  69.   until (not fileexists(file_name));
  70.   end;
  71.  
  72.   assign(ar, file_name);
  73.   rewrite(ar);
  74.   close(ar);
  75. {$I+}
  76.  
  77. end;
  78.  
  79. end.